home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / t3_1 / nexttsrc.lha / nexttsources / sources / comp / assembler / as_utils.t < prev    next >
Encoding:
Text File  |  1988-02-05  |  5.3 KB  |  144 lines
  1. (herald (assembler as_utils t 3)
  2.         (env t (assembler ib)))  ;  get-value needs
  3.  
  4. ;;; Copyright (c) 1985 Yale University
  5. ;;;     Authors: N Adams, R Kelsey, D Kranz, J Philbin, J Rees.
  6. ;;; This material was developed by the T Project at the Yale University Computer 
  7. ;;; Science Department.  Permission to copy this software, to redistribute it, 
  8. ;;; and to use it for any purpose is granted, subject to the following restric-
  9. ;;; tions and understandings.
  10. ;;; 1. Any copy made of this software must include this copyright notice in full.
  11. ;;; 2. Users of this software agree to make their best efforts (a) to return
  12. ;;;    to the T Project at Yale any improvements or extensions that they make,
  13. ;;;    so that these may be included in future releases; and (b) to inform
  14. ;;;    the T Project of noteworthy uses of this software.
  15. ;;; 3. All materials developed as a consequence of the use of this software
  16. ;;;    shall duly acknowledge such use, in accordance with the usual standards
  17. ;;;    of acknowledging credit in academic research.
  18. ;;; 4. Yale has made no warrantee or representation that the operation of
  19. ;;;    this software will be error-free, and Yale is under no obligation to
  20. ;;;    provide any services, by way of maintenance, update, or otherwise.
  21. ;;; 5. In conjunction with products arising from the use of this material,
  22. ;;;    there shall be no use of the name of the Yale University nor of any
  23. ;;;    adaptation thereof in any advertising, promotional, or sales literature
  24. ;;;    without prior written consent from Yale in each case.
  25. ;;;
  26.  
  27. ;;; Runtime support for the assembler (and maybe descriptions).
  28.  
  29. (define (walk-backwards proc list)
  30.   (cond ((null? list) 'done)
  31.         (else (walk-backwards proc (cdr list))
  32.               (proc (car list)))))
  33.  
  34. (define (fixnum-mod x y)
  35.   (cond ((fx< x 0)
  36.          (fx- (fx- y 1) (fixnum-remainder (fx- -1 x) y)))
  37.         (else (fixnum-remainder x y))))
  38.  
  39. ;(define bref (*value *t-implementation-env* 'bref))
  40. ;(define make-bytev (*value *t-implementation-env* 'make-bytev))
  41.  
  42. ;;; GET-VALUE is called from FG and from BITS.
  43. ;;;    DESTRUCTURE-FG, CONTEXT-FG, BITS-FG
  44. ;;; GET-FIXED-VALUE is called only from FG
  45. ;;;    COMPRESS-FG
  46.  
  47. (define (get-fixed-value vop voc1 vars vals)
  48.   (xselect vop
  49.     ((vop/const) (vref vals voc1))
  50.     ((vop/var)   (let ((expr (vref vars voc1)))
  51.                    (cond ((fixnum? expr) expr)
  52.                          (else 
  53.                           (no-op (error "assembler expecting fixed value, got ~s"
  54.                                         expr))))))
  55.     ((vop/proc)  ((vref vals voc1) vars))))
  56.  
  57. (define (get-value vop voc1 vars vals)
  58.   (xselect vop
  59.     ((vop/const) (vref vals voc1))
  60.     ((vop/var)   (let ((expr (vref vars voc1)))
  61.                    (cond ((fixnum? expr) expr)  
  62.                          ((procedure? expr) (expr vars))
  63.                          (else expr))))
  64.     ((vop/proc)  ((vref vals voc1) vars))
  65.     ))
  66.     
  67. ;;; Called from expressions in machine decriptions that use DISP or FROM.
  68.  
  69. (define-integrable (expr-compute-disp vars mark-index dest-expr)
  70.   (let ((mark-address (vref *mark-addresses* mark-index)))
  71.      (cond ((ib? dest-expr) 
  72.             (fx- (ib-address dest-expr) mark-address))
  73.            (else                           
  74.             (no-op 
  75.               (error "bad arguments to EXPR-COMPUTE-DISP - DISP and FROM expect a mark and a tag"))))))
  76.  
  77. ;;; This is provided to be used from machine decriptions expressions.
  78.  
  79. (define (mark-address mark-index)
  80.   (vref *mark-addresses* mark-index))
  81.  
  82. ;;; Enumerated types
  83.  
  84. ;;; Branches - this is hacked as numbers to make branch reversal fast.
  85. ;;; This is probably not necessary.
  86. ;;; Used by assembler, as clients, as client compiler.
  87.  
  88. ;;; carry set   is the same as uj<
  89. ;;; carry clear is the same as uj>=
  90.  
  91. (define-constant jump-op/jabs 0)
  92. (define-constant jump-op/jn=  1) (define-constant jump-op/j=   -1)
  93. (define-constant jump-op/j>   2) (define-constant jump-op/j<=  -2)
  94. (define-constant jump-op/j>=  3) (define-constant jump-op/j<   -3)
  95. (define-constant jump-op/uj>  4) (define-constant jump-op/uj<= -4) 
  96. (define-constant jump-op/uj>= 5) (define-constant jump-op/uj<  -5)
  97. (define-constant jump-op/not_negative 6) (define-constant jump-op/negative -6)
  98. (define-constant jump-op/no_overflow  7) (define-constant jump-op/overflow -7) 
  99.                                                                    
  100.  
  101. ;;; For listings & other output.
  102.  
  103. (define (jump-op-name op)
  104.     (xcond ((and (fx>= op 0) (fx<= op 7))
  105.             (vref '#("abs" "neq" "gt " "ge " "gtu" "geu" "pos" "vc") op))
  106.            ((and (fx>= op -7) (fx< op 0))
  107.             (vref '#("abs" "eq " "le " "lt " "leu" "ltu" "neg" "vs") (fx- 0 op)))))
  108.  
  109. (define reverse-jump fixnum-negate)
  110.  
  111. ;;; This is stuff the assembler uses all over
  112.  
  113. ;;; AS internal enumerations
  114.  
  115. (define-constant vop/const 0)
  116. (define-constant vop/var   1)
  117. (define-constant vop/proc  2)
  118.  
  119. ;;; Compute 1 time
  120. (define-constant wop/fix          0)
  121. (define-constant wop/@fix         1)
  122. (define-constant wop/proc         2)
  123.  
  124. (define-constant wop/subfield-ic  3)
  125.  
  126. ;;; Recompute
  127. (define-constant wop/var          4)
  128. (define-constant wop/depending-on 5)
  129. (define-constant wop/d-o          wop/depending-on)
  130.  
  131. (define-constant wop/mark         6)
  132.  
  133. ;;; Field size stuff (more in AS_OPEN)
  134.  
  135. (define (lessp x y z)
  136.   (and (<= x y) (< y z)))
  137.  
  138. (define (32bit? n)
  139.   (lessp #x-80000000 n #x80000000))
  140.  
  141. (define (32bit-u? n)
  142.   (lessp -1 n #x100000000))
  143.  
  144.